CD ROM Paradise Collection 4/CD ROM Paradise Collection 4 1995 Nov.iso/program/swagn_r.zip/POINTERS.SWG/0023_Match Strings in Array.pas

Pascal/Delphi Source File | 1994-08-24 | 6KB | 221 lines

{* Stack Research string for turbo pascal unit *}
{* Public Domain, 21/07/94 by Mark Gauthier.   *}
{* Fidonet 1:242/818.5, FM 101:190/805.5       *}

Unit Search;

{ What for?, it use stack function to search for a matching string
  in an array. }

Interface

Const

        MaxString : Word = 4096;
        MaxStack  : Word = 500;

Var
        StrAddr         : Array[1..4096] of Pointer;
        { Addresse for all strings. }

        TotalStr        : Word;
        { Curent strings number }

        StrFreq         : Array[1..4096] of Word;
        { Search frequence for each string }

        procedure ClearAllStack;
        { Clear stack.  You must call this procedure to tell unit
          you will change the searchstring. }

        procedure AddString (S:String);
        { Add a string in array, only if totalstr if < maxstring. }

        function  SearchString (S:String) : boolean;
        { Search for a string, if stack is not clear previous search as
          been made. Example: you search for 'ABC' and this function
          return true.  If you search for 'ABCD' then this function
          will go in stack and get all the old addr for 'ABC' and see
          if 'D' is the next letter for the check strings.

          * This unit is usefull to build compression unit.
        }

implementation

Var
        SearchStr       : Pointer;
        LastFound       : Word;
        CurentStack     : Byte;
        StackPos        : Array[1..2] of Word;
        StackData       : Array[1..2,1..500] of Word;

{*===================================================================*}

{ Return true is stack is empty }
function StackIsEmpty:boolean;
begin
     StackIsEmpty := false;
     if StackPos[CurentStack] = 0 then StackIsEmpty := true;
end;

{*===================================================================*}

{ Pop an element from stack }
function MgPop:Word;
begin
     MgPop := 0;
     If Not StackIsEmpty then
     begin
          MgPop := StackData[CurentStack, StackPos[CurentStack]];
          Dec(StackPos[CurentStack]);
     end;
end;

{*===================================================================*}

{ Push an element on stack }
procedure MgPush(Number:word);
var x:byte;
begin
     if CurentStack = 1 then x := 2 else x := 1;
     If StackPos[x] < MaxStack then
     begin
          Inc(StackPos[x]);
          StackData[x, StackPos[x]] := Number;
     end;
end;

{*===================================================================*}

{ Clear the curent stack }
procedure ClearStack;
begin
     StackPos[CurentStack] := 0;
end;

{*===================================================================*}

{ Inverse pop and push stack }
procedure InverseStack;
begin
     ClearStack;
     If CurentStack = 1 then CurentStack := 2 else CurentStack := 1;
end;

{*===================================================================*}

{ Compare SearchStr(global var) and DATA(parameter) }
{$F+}
function Compare(Data:Pointer):boolean;assembler;
asm
          push      bp
          mov       bp,sp

          push      ds

          lds       si,SearchStr
          lodsb
          mov       cl,al
          mov       ch,0

          les       di,[Bp+8]
          inc       di

          mov       al,0
          cld
          repe      cmpsb
          jne       @NotMatch
          mov       al,1

@NotMatch:

          pop       ds
          pop       bp
end;
{$F-}

{*===================================================================*}

{ Search procedure execute this procedure if stack is not empty. }
function SearchWhitPop:boolean;
Var Start : Word;
begin
     SearchWhitPop := false;
     While not StackIsEmpty do
     begin
          Start := MgPop;
          if Compare(StrAddr[Start]) then
          begin
                LastFound := Start;
                SearchWhitPop := true;
                MgPush(Start);
                Inc(StrFreq[Start]);
          end;
     end;
     InverseStack;
end;

{*===================================================================*}

{ Search procedure execute this procedure if stack is empty. }
function CompleteSearchPush:boolean;
var i : word;
begin
     CompleteSearchPush := false;
     For i := 1 to TotalStr do
     begin
          if Compare(StrAddr[i]) then
          begin
                LastFound := i;
                CompleteSearchPush := true;
                MgPush(i);
                Inc(StrFreq[i]);
          end;
     end;
     InverseStack;
end;

{*===================================================================*}

{ Public Search routine }
function SearchString(S:String):boolean;
begin
     SearchStr := Addr(S);
     If StackIsEmpty
     then SearchString := CompleteSearchPush
     else SearchString := SearchWhitPop;
end;

{*===================================================================*}

{ Add a string in heap }
procedure AddString(S:String);
begin
     Inc(TotalStr);
     GetMem(StrAddr[TotalStr], Length(S));
     Move(S,StrAddr[TotalStr]^, Length(S)+1);
end;

{*===================================================================*}

{ Clear pop and push stack }
procedure ClearAllStack;
begin
     InverseStack;
     ClearStack;
end;

{*===================================================================*}

{ Unit Initialisation }
var i : word;
Begin
     TotalStr    := 0;
     CurentStack := 0;
     StackPos[1] := 0;
     StackPos[2] := 0;
     for i := 1 to 4096 do StrFreq[i] := 0;
End.